home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / dos / basic / gcopy.bas (.txt) < prev    next >
Encoding:
GW-BASIC  |  1984-02-26  |  5.2 KB  |  90 lines
  1. 100  '**********************************************************************
  2. 200  '*****              GCOPY  -  COPY FILES IN BASIC                 *****
  3. 300  '***** This program copies files in general, but the lengths      *****
  4. 400  '***** of the source and target files will match only if the      *****
  5. 500  '***** source file length is a multiple of 128 bytes.             *****
  6. 700  '**********************************************************************
  7. 800  CLS
  8. 900  COMMON GCHAIN$,F$                   'VARIABLES IN MENU BASED SYSTEM
  9. 1000  FMTSIZ$="######"                   'FORMAT STRING FOR FILE SIZE
  10. 1100  INPUT "ENTER THE NAME OF THE FILE TO BE COPIED: ";F1$
  11. 1200  INPUT "ENTER THE NAME OF THE TARGET FILE   : ";F2$
  12. 1300  IF F1$="" THEN F1$=F$              ' DEFAULT IS COPY FROM FILE PASSED.
  13. 1400  '
  14. 1500  OPEN F1$  AS  1 LEN=512            'TREAT EVERYTHING AS 512 BYTE RECORDS
  15. 1600  FCB1% = VARPTR(#1)                 'SET PTR TO FCB FOR INPUT FILE
  16. 1700  BYTESIZ1# = PEEK(FCB1%+17)+256*PEEK(FCB1%+18)+256*256*PEEK(FCB1%+20)                +256*256*256*PEEK(FCB1%+19)     'Calculate file size in bytes
  17. 1800  TDATE% = PEEK(FCB1%+21) OR 256*PEEK(FCB1%+22)      'Get file date
  18. 1900  GOSUB 8300                         'Convert date to character format
  19. 2000  PRINT F1$; TAB(15);                ' Format and print file name
  20. 2100  PRINT USING FMTSIZ$; BYTESIZ1# ;   ' and file size
  21. 2200  PRINT TAB(22) ; SDATE$             ' and the last modified date
  22. 2300  IF BYTESIZ1# = 0 THEN PRINT  "SOURCE FILE IS EMPTY!"
  23. 2400  OPEN F2$  AS  2 LEN=512            'TREAT EVERYTHING AS 512 BYTE RECORDS
  24. 2500  FCB2% = VARPTR(#2)                 'SET PTR TO FCB FOR INPUT FILE
  25. 2600  BYTESIZ2# = PEEK(FCB2%+17)+256*PEEK(FCB2%+18)+256*256*PEEK(FCB2%+20)                +256*256*256*PEEK(FCB2%+19)    ' It's a four byte field & blows >32767
  26. 2700  TDATE% = PEEK(FCB2%+21) OR 256*PEEK(FCB2%+22)
  27. 2800  GOSUB 8300
  28. 2900  PRINT F2$; TAB(15);                ' Print the file name
  29. 3000  PRINT USING FMTSIZ$; BYTESIZ2# ;   '  and file size
  30. 3100  PRINT TAB(22) ; SDATE$             '  and the last modified date
  31. 3200  IF BYTESIZ1# = 0 THEN 4200
  32. 3300  INPUT "TARGET FILE CONTAINS DATA.  RELY 'YES'  TO OVERLAY:"; A$
  33. 3400  IF A$ = "YES" OR A$ = "yes"  THEN 3500  ELSE PRINT "COPY CANCELLED." : GOTO 6600
  34. 3500  '*************************************************************************
  35. 3600  '**                                                                *******
  36. 3700  '**                        DO  THE  COPY                           *******
  37. 3800  '**                                                                *******
  38. 3900  '*************************************************************************
  39. 4000  FIELD #1, 255 AS A1$, 255 AS A2$, 2 AS A3$         'STUFF IN RECORDS
  40. 4100  FIELD #2, 255 AS B1$, 255 AS B2$, 2 AS B3$
  41. 4200  BLKCT% = BYTESIZ1# \512                        'NO. OF BYTES IN LAST BLK
  42. 4300  REMCT% = BYTESIZ1#-512*BLKCT%                  'NO. OF BYTES IN LAST BLK
  43. 4400  FOR I% = 1 TO BLKCT%
  44. 4500     GET #1,I%                                   ' READ 512 BYTE SECTOR
  45. 4600     LSET B1$ = A1$                              ' 1ST 255 CHARS
  46. 4700     LSET B2$ = A2$                              ' 2ND 255 CHARS
  47. 4800     LSET B3$ = A3$                              ' LAST 2 CHARS
  48. 4900     PUT #2,I%                                   ' PUT THE SECTOR
  49. 5000  NEXT I%
  50. 5100  IF REMCT% = 0  THEN GOTO 6500
  51. 5200  GET #1
  52. 5300  CLOSE #2: OPEN F2$ FOR APPEND AS #2           ,HANDLE SHORT LAST SECTOR
  53. 5400  '
  54. 5500  '  ==> THERE IS A PROBLEM HERE: BASIC ONLY RECOGNIZES 128 BYTE INCREMENTS.
  55. 5600  '  ==> THEREFORE , EVEN IF THE SOURCE FILE LENGTH IS NOT A MULTIPLE OF
  56. 5700  '  ==> 128 , THE TARGET FILE WILL BE...
  57. 5800  '
  58. 5900  IF REMCT% > 510 THEN FIELD #1, 255 AS AA1$, 255 AS AA2$, 1 AS AA3$:                   PRINT #2, AA1$;: PRINT #2, AA2$;: PRINT #2, AA3$;: GOTO 6500
  59. 6000  IF REMCT% > 255 AND REMCT% <= 510 THEN FIELD #1,  255 AS AA1$,                       REMCT% - 255 AS AA2$  : PRINT #2, AA1$;: PRINT #2,AA2$;: GOTO 6500
  60. 6100  IF REMCT% > 0 AND REMCT% <= 255  THEN FIELD #1, REMCT% AS AA1$
  61. 6200  PRINT #2,AA1$
  62. 6300  '*************************************************************************
  63. 6400  PRINT "COPY COMPLETE from "; F1$ " TO "; F2$; ".   ";BLKCT%;" BLKS COPIED"
  64. 6500  CLOSE
  65. 6700  STOP: END
  66. 6800  'S************************************************************************
  67. 6900  '*****     CONVERT THE CURRENT DATE TO INTERNAL FORMAT             *******
  68. 7000  '*****     INPUT  -  SDATE$            OUTPUT  -  TDATE%           *******
  69. 7100  '*************************************************************************
  70. 7200  DTMO% = VAL(MID$(SDATE$,1,2)) * 32               'month in bits 8 to 5
  71. 7300  DTDA% = VAL(MID$(SDATE$,4,2))                    'day of the month
  72. 7400  DTYR% = (VAL(MID$(SDATE$,7,4)) - 1980) * 512     'year relative to 1980
  73. 7500  TDATE% = DTYR% OR DTMO% OR DTDA%
  74. 7600  RETURN
  75. 7700  'S************************************************************************
  76. 7800  '*****     CONVERT A DATE FROM INTERNAL FORMAT TO STRING FORMAT    *******
  77. 7900  '*****     INPUT  -  TDATE%             OUTPUT  -  SDATE$          *******
  78. 8000  '*****     Refer to page E-8 in the appendix of the DOS manual     *******
  79. 8100  '*****      for the internal date format.                          *******
  80. 8200  '*************************************************************************
  81. 8300  DTYR% = (TDATE% \ 512 ) + 1980
  82. 8400  DTI% = (TDATE% - (DTYR% - 1980) * 512)
  83. 8500  DTMO% = DTI% \ 32
  84. 8600  DTDA% = DTI% - DTMO% * 32
  85. 8700  SDATE$ = "0m-0d-YYYY"
  86. 8800  MID$( SDATE$,1,2 ) = RIGHT$( STR$(DTMO%+100) ,2)
  87. 8900  MID$( SDATE$,4,2 ) = RIGHT$( STR$(DTDA%+100), 2 )
  88. 9000  MID$( SDATE$,7,4 ) = RIGHT$( STR$(DTYR%), 4 )
  89. 9100  RETURN
  90.